home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / scope / 051-075 / scopedisk51 / wcs20 / willi < prev    next >
Text File  |  1995-03-18  |  24KB  |  781 lines
  1.   WINDOW 1,"WCS v2.0",(417,11)-(617,59),31,-1
  2.   COLOR 3:PRINT "Initializing..."
  3.  
  4.   CLEAR,38000&
  5.   DEFINT a-z
  6.   at&=0:text&=0:printat&=0:shadow&=0:sxy&=0:scolr&=0:sbox&=0:dbox&=0
  7.   drawmode&=0:title&=0:loadfont&=0:usefont&=0:killfont&=0:style&=0
  8.   refresh&=0:iffload&=0:iffsave&=0:loadRGB&=0:saveRGB&=0:request&=0
  9.   checkfile&=0:bload&=0:bsave&=0:bopenr&=0:bopenw&=0:bread&=0:bwrite&=0
  10.   seek&=0:bclose&=0:getmem&=0:freemem&=0:zero&=0:copy&=0:w7&=0:bye&=0
  11.  
  12.   filesize&=0:ml&=0
  13.   brick=0:rock=1:willi=2:gold=3:dirt=4:empty=5
  14.   a=0:c=0:i=0:m=0:freq=0:crunched=0:greed=0:part=2
  15.   x=0:y=0:wx=0:wy=0:rx=0:ry=0:joyx=0:joyy=0:mx=0:my=0
  16.   inthebox=0:roll=0:listflag=0:newrandom=-1
  17.   top$="___":default$="NEW":nl$=CHR$(0)
  18.  
  19.   GOSUB setstart
  20.  
  21.   DIM board(30,17),backboard(30,17,6)
  22.   DIM topscore!(6),topname$(6),title$(6)
  23.   DIM pparts(36,5),empty(1),brick(63),rgb(32)
  24.   empty(0)=-1:empty(1)=-1
  25.  
  26.   DIM ml(99)
  27.   OPEN "wcs/ml_loader" FOR INPUT AS #1
  28.     FOR i=0 TO 99:ml(i)=CVI(INPUT$(2,1)):NEXT
  29.   CLOSE #1
  30.   ml&=VARPTR(ml(0)):ml& SADD("wcs/jlib"+nl$),VARPTR(at&),WINDOW(7)
  31.   ERASE ml
  32.  
  33.   WINDOW CLOSE 1
  34.   SCREEN 1,640,200,4,2
  35.   WINDOW 2,SPACE$(14)+"T H E   W I L L I   C O N S T R U C T I O N   S E T",,0,1
  36.   w7& WINDOW(7):sxy& 2,1
  37.   CHDIR "wcs"
  38.   file$="RGB"
  39.   checkfile& SADD(file$+nl$),VARPTR(filesize&)
  40.   IF filesize&<>64 THEN noload
  41.   bload& SADD(file$+nl$),VARPTR(rgb(0)),64
  42.   loadRGB& VARPTR(rgb(0)),32
  43.   file$="pieces.parts"
  44.   checkfile& SADD(file$+nl$),VARPTR(filesize&)
  45.   IF filesize&<>376 THEN noload
  46.   bload& SADD(file$+nl$),VARPTR(pparts(0,0)),376
  47.   copy& VARPTR(pparts(3,brick)),VARPTR(brick(0)),34
  48.   file$=default$
  49.  
  50.   GOSUB brick:LINE (0,0)-(630,186),,bf:PATTERN ,empty
  51.   msgbox 2,"Welcome to The Willi Construction Set!"
  52.   GOSUB flash
  53.   scolr& 1,8:shadow& 145,24,SADD("The Willi Construction Set"+nl$)
  54.   shadow& 133,34,SADD("Version 2.0 - by john everett"+nl$)
  55.   scolr& 2,9
  56.   shadow& 57,54,SADD("This program found first on"+nl$)
  57.   scolr& 1,6:shadow& 283,54,SADD("American PeopleLINK!"+nl$)
  58.   scolr& 2,1:shadow& 283,53,SADD("American PeopleLINK!"+nl$)
  59.   scolr& 3,10:shadow& 101,74,SADD("Use joystick (port2) to control Willi"+nl$)
  60.   scolr& 4,11:shadow& 73,84,SADD("Collect flowers while avoiding falling rocks"+nl$)
  61.   scolr& 5,12:shadow& 93,94,SADD("If you get stuck,  press `r' for `rock'"+nl$)
  62.   scolr& 6,13:shadow& 65,104,SADD("(the rock will land on Willi's head,  however)"+nl$)
  63.   scolr& 7,14:shadow& 97,114,SADD("Press ESC if you want to quit the game"+nl$)
  64.  
  65.   GOSUB scoreboard
  66.   GOSUB newscreens
  67.   MENU 1,0,1,"System"
  68.     MENU 1,1,1,"About       "
  69.     MENU 1,2,1,"Instructions"
  70.     MENU 1,3,1,"List Willi  "
  71.     MENU 1,4,1,"Quit Willi  "
  72.   MENU 2,0,1,"Options"
  73.     MENU 2,1,1,"Load Screens"
  74.     MENU 2,2,1,"Edit Screens"
  75.     MENU 2,3,1,"Edit Pieces "
  76.     MENU 2,4,1,"Zero Scores "
  77.     MENU 2,5,1,"Restart Game"
  78.   MENU 3,0,0,""
  79.   MENU 4,0,0,""
  80.   GOTO start
  81.  
  82. mainloop:
  83.   joyx=0:joyy=0
  84.   WHILE joyx=0 AND joyy=0 AND m=0 AND key$=""
  85.     joyx=STICK(2):joyy=STICK(3):m=MENU(0):key$=INKEY$:GOSUB ptime
  86.   WEND
  87.   IF key$<>"" OR m<>0 THEN whatkey
  88.   x=wx+joyx:y=wy+joyy
  89.   IF x>30 OR x<0 OR y>17 OR y<0 THEN mainloop
  90.   IF board(x,y)=brick THEN mainloop
  91.   IF joyx<>0 AND joyy<>0 AND board(x,wy)<2 AND board(wx,y)<2 THEN mainloop
  92.   IF board(x,y)=rock THEN pushrock
  93.   IF board(x,y)=gold THEN greed=greed-1
  94.   board(wx,wy)=empty:LINE (wx*16,wy*8)-STEP(15,7),0,bf
  95.   wx=x:wy=y:SOUND 200,.2,255:SOUND 200,.2,255,1
  96.   board(wx,wy)=willi:PUT (16*wx,8*wy),pparts(0,willi),PSET
  97.   IF wy-joyy>0 THEN
  98.     IF board(wx-joyx,wy-joyy-1)=rock THEN rx=wx-joyx:ry=wy-joyy-1:GOSUB rockfall
  99.   END IF
  100.   IF greed<1 THEN GOTO nextlevel
  101.   GOTO mainloop
  102.  
  103. rockfall:
  104.   a=0
  105. numfall:
  106.   IF board(rx,ry-a)=rock THEN a=a+1:IF ry-a>-1 THEN numfall
  107.   FOR i=0 TO a-1:x=rx:y=ry-i:GOSUB howfall:NEXT
  108.   RETURN
  109. howfall:
  110.   roll=0
  111.   IF y+1>17 THEN bottom
  112.   IF board(x,y+1)=empty THEN
  113.     LINE (x*16,y*8)-STEP(15,7),0,bf
  114.     board(x,y)=empty:y=y+1:board(x,y)=rock
  115.     PUT (16*x,8*y),pparts(0,rock),PSET
  116.     SOUND 4000-200*y,.2,255
  117.     GOTO howfall
  118.   END IF
  119.   GOSUB ptime
  120.   IF board(x,y+1)=willi THEN
  121.     LINE (x*16,y*8)-STEP(15,7),0,bf
  122.     y=y+1:GOTO crunch
  123.   END IF
  124.   IF board(x,y+1)=rock THEN
  125.     IF x>0 THEN
  126.       IF board(x-1,y)=empty AND (board(x-1,y+1)=willi OR board(x-1,y+1)=empty) THEN roll=-1
  127.     END IF
  128.     IF x<30 THEN
  129.       IF board(x+1,y)=empty AND (board(x+1,y+1)=willi OR board(x+1,y+1)=empty) THEN
  130.         IF roll THEN roll=SGN(RND-.5) ELSE roll=1
  131.       END IF
  132.     END IF
  133.     IF roll<>0 AND board(x+roll,y)=empty THEN
  134.       board(x,y)=empty:board(x+roll,y)=willi
  135.       LINE (x*16,y*8)-STEP(15,7),0,bf
  136.       x=x+roll:GOTO howfall
  137.     END IF
  138.   END IF
  139. bottom:
  140.   SOUND 100,1,255,0:SOUND 100,1,255,1
  141.   RETURN
  142.  
  143. pushrock:
  144.   IF x+joyx<0 OR x+joyx>30 OR joyy<>0 THEN mainloop
  145.   IF board(x+joyx,wy)<>empty THEN mainloop
  146.   LINE (wx*16,wy*8)-STEP(15,7),0,bf
  147.   LINE (x*16,y*8)-STEP(15,7),0,bf
  148.   board(wx,wy)=empty
  149.   wx=x:wy=y
  150.   board(wx,wy)=willi
  151.   x=x+joyx
  152.   board(x,y)=rock
  153.   PUT (16*wx,8*wy),pparts(0,willi),PSET
  154.   PUT (16*x,8*y),pparts(0,rock),PSET
  155.   SOUND 700,.2,255,0:SOUND 700,.2,255,1
  156.   IF y<17 THEN IF board(x,y+1)=empty THEN rx=x:ry=y:GOSUB rockfall
  157.   IF wx>0 AND wy>0 THEN
  158.     IF board(wx-joyx,wy-1)=rock THEN rx=wx-joyx:ry=wy-1:GOSUB rockfall
  159.   END IF
  160.   GOTO mainloop
  161.  
  162. ptime:
  163.   COLOR level+8,level+1:LOCATE 2*level+3,65
  164.   IF level>0 THEN PRINT USING "####.#";TIMER-starttime!
  165.   RETURN
  166.  
  167. whatkey:
  168.   endtime!=TIMER-starttime!
  169.   IF m<>0 THEN ON m GOTO menu1,menu2
  170.   IF key$=CHR$(27) THEN quit
  171.   IF key$="R" THEN newrandom=-1
  172.   IF UCASE$(key$)="R" THEN x=wx:y=wy:GOTO crunch
  173.   IF key$=CHR$(139) THEN GOSUB instructions:GOTO start
  174.   IF key$=>"0" AND key$<="6" THEN
  175.     msgbox 1,"WARPING DISQUALIFIES ALL HIGH SCORES FOR THIS GAME"
  176.     GOSUB checkbox
  177.     IF inthebox THEN
  178.       IF topflag THEN GOSUB hurrah
  179.       level=VAL(key$):topflag=1
  180.       msgbox 1,"Warping to Level"+STR$(level)
  181.       GOTO start
  182.     END IF
  183.   END IF
  184.   key$="":starttime!=TIMER-endtime!
  185.   GOTO mainloop
  186.  
  187. brick: PATTERN ,brick:POKE WINDOW(8)+29,-3 AND 255:COLOR 15,0:RETURN
  188.  
  189. setstart:
  190.   IF topflag THEN GOSUB hurrah
  191.   man=10:level=0:topflag=0:startflag=0
  192.   starttime!=0:endtime!=0:totaltime!=0
  193.   RETURN
  194.  
  195. crunch:
  196.   msgbox 1,"OUCH!!! --- THAT HURTS!!!"
  197.   FOR freq=0 TO 3000 STEP 200
  198.     PUT (16*x,8*y),pparts(0,willi),PSET
  199.     SOUND 1.25*freq,.2,255
  200.     PUT (16*x,8*y),pparts(0,rock),PSET
  201.     SOUND freq,.2,255,1
  202.     GOSUB ptime
  203.   NEXT
  204.   GOSUB flash
  205.   man=man-1
  206.   scolr& 2,9:shadow& 168,32,SADD("A cat has nine lives."+nl$)
  207.   scolr& 3,10:shadow& 192,48,SADD("Willi has ten!"+nl$)
  208.   scolr& 4,11:shadow& 88,64,SADD("You have just wasted one of those lives!"+nl$)
  209.   FOR i=96 TO (9-man)*32+96 STEP 32:PUT (i,80),pparts(0,rock),PSET:NEXT
  210.   FOR i=i TO 384 STEP 32:PUT (i,80),pparts(0,willi),PSET:NEXT
  211.   scolr& 5,12:shadow& 160,96,SADD("Willi has   lives left."+nl$)
  212.   scolr& 6,13:shadow& 232,96,SADD(STR$(man)+nl$)
  213.   IF man=0 THEN
  214.     FOR i=0 TO 7
  215.       dbox& 154,76,i,i+7,SADD("You have killed Willi!"+nl$)
  216.       SOUND 400-5*i,2,255:SOUND 400-i*11,2,255,1
  217.       pause 1!
  218.       LINE (144,76)-STEP(200,14),0,bf
  219.       SOUND 300-5*i,2,255:SOUND 300-i*11,2,255,1
  220.       pause 1!
  221.     NEXT
  222.     GOTO restart
  223.   ELSE
  224.     pause 3!
  225.   END IF
  226.   crunched=1
  227.  
  228. nextlevel:
  229.   endtime!=TIMER-starttime!
  230.   IF level>0 THEN
  231.     COLOR level+8,level+1:LOCATE 2*level+3,65:PRINT USING "####.#";endtime!
  232.     COLOR 7,0:LOCATE 19,65:PRINT USING "####.#";totaltime!+endtime!;
  233.   END IF
  234.   IF crunched=1 THEN crunched=0:GOTO start
  235.   IF level>0 AND topflag<1 THEN
  236.     IF endtime!<topscore!(level) OR topscore!(level)=0 THEN
  237.       topscore!(level)=endtime!:topname$(level)="****":topflag=-1
  238.     END IF
  239.     COLOR level+8,level+1
  240.     LOCATE 2*level+3,73:PRINT USING "####.#";topscore!(level)
  241.     totaltime!=totaltime!+endtime!
  242.   END IF
  243.   endtime!=0
  244.   level=level+1:IF level>6 THEN winner
  245.  
  246. start:
  247.   ON startflag GOTO latestart,verylatestart
  248.   IF level=0 AND newrandom=-1 THEN GOSUB randomlevel
  249.   GOSUB getboard
  250. latestart:
  251.   msgbox 1,file$+" - Level"+STR$(level)+": "+title$(level)
  252.   GOSUB showboard
  253. verylatestart:
  254.   startflag=0
  255.   msgbox 2,"Press FIRE! button to start playing"
  256.   key$="":WHILE STRIG(3)=0 AND key$="" AND m=0:key$=INKEY$:m=MENU(0):SLEEP:WEND
  257.   msgbox 2,""
  258.   starttime!=TIMER-endtime!
  259.   GOTO mainloop
  260.  
  261. getboard:
  262.   copy& VARPTR(backboard(0,0,level)),VARPTR(board(0,0)),558
  263.   wx=wx(level):wy=wy(level):greed=greed(level)
  264.   RETURN
  265. showboard:
  266.   LINE (0,0)-(498,144),1,bf
  267.   LINE (0,0)-(496,143),0,bf
  268.   FOR y=0 TO 17
  269.     SOUND 400,.4,255,0:SOUND 700,.4,255,1
  270.     FOR x=0 TO 30
  271.       PUT (16*x,8*y),pparts(0,board(x,y))
  272.     NEXT
  273.   NEXT
  274.   SOUND 400,1,255,0:SOUND 800,1,255,1
  275.   RETURN
  276.  
  277. randomlevel:
  278.   SOUND 400,2,255,0:SOUND 400,2,255,1
  279.   GOSUB bestscores
  280.   RANDOMIZE TIMER
  281.   FOR y=0 TO 17:FOR x=0 TO 30:backboard(x,y,0)=dirt:NEXT:NEXT
  282.   FOR i=1 TO 120:backboard(INT(31*RND),INT(17*RND),0)=rock:NEXT
  283.   FOR i=1 TO 40:backboard(INT(31*RND),INT(17*RND),0)=brick:NEXT
  284.   greed=0
  285.   FOR i=1 TO 30
  286.     x=INT(31*RND):y=INT(17*RND)
  287.     IF backboard(x,y,0)<>gold THEN greed=greed+1
  288.     backboard(x,y,0)=gold
  289.   NEXT
  290.   RESTORE randomlevel
  291.   FOR y=40 TO 47
  292.     READ key$
  293.     FOR x=328 TO 351
  294.       IF backboard(x-324,y-35,0)=rock THEN backboard(x-324,y-35,0)=dirt
  295.       IF POINT (327,40)=0 THEN
  296.         IF POINT (x,y)=1 THEN
  297.           IF backboard(x-324,y-35,0)=gold THEN greed=greed-1
  298.           backboard(x-324,y-35,0)=rock
  299.         END IF
  300.       ELSE
  301.         IF MID$(key$,x-327,1)="X" THEN
  302.           IF backboard(x-324,y-35,0)=gold THEN greed=greed-1
  303.           backboard(x-324,y-35,0)=rock
  304.         END IF
  305.       END IF
  306.     NEXT
  307.   NEXT
  308.   backboard(1,16,0)=willi:wx(0)=1:wy(0)=16:greed(0)=greed
  309.   title$(level)="Warm-Up"
  310.   newrandom=0
  311.   RETURN
  312.  
  313.   DATA "XX---XX---XXXX----XXXX--"
  314.   DATA "XX---XX--XX--XX--XX--XX-"
  315.   DATA "XX---XX-XX-------XXX----"
  316.   DATA "XX-X-XX-XX--------XXX---"
  317.   DATA "XXXXXXX-XX----------XXX-"
  318.   DATA "XXX-XXX--XX--XX--XX--XX-"
  319.   DATA "XX---XX---XXXX----XXXX--"
  320.   DATA "------------------------"
  321.  
  322. bestscores:
  323.   msgbox 1,"Here are the Best Scores for "+file$
  324.   GOSUB brick:LINE (0,0)-(498,144),,bf:PATTERN ,empty
  325.   IF topscore!(0)>0 THEN
  326.     i=0:GOSUB fixscore
  327.     msg$="*    "+score$+"   seconds   by   "+topname$(0)+"     *"
  328.     LINE (84,19)-(411,59),0,bf
  329.     LINE (88,21)-(407,57),1,bf
  330.     LINE (92,23)-(403,55),0,bf
  331.     scolr& 1,8
  332.     shadow& 96,24,SADD("**************************************"+nl$)
  333.     shadow& 96,32,SADD("* Best total time for completed game *"+nl$)
  334.     shadow& 96,40,SADD(msg$+nl$)
  335.     shadow& 96,48,SADD("**************************************"+nl$)
  336.   END IF
  337.   IF topscore!(1)>0 THEN
  338.     LINE (84,67)-(411,124),0,bf
  339.     LINE (88,69)-(407,122),1,bf
  340.     LINE (92,71)-(403,120),0,bf
  341.     FOR i=1 TO 6
  342.       IF topscore!(i)>0 THEN
  343.         GOSUB fixscore
  344.         scolr& i+1,i+8:shadow& 96,8*(i+9)-8,SADD("Best time for Level"+STR$(i)+" is "+score$+" by "+topname$(i)+nl$)
  345.       END IF
  346.     NEXT
  347.   END IF
  348.   RETURN
  349. fixscore:
  350.   score$=STR$(INT(10*topscore!(i))/10)
  351.   IF INSTR(score$,".")=0 THEN score$=score$+".0"
  352.   score$=RIGHT$("     "+score$,6)
  353.   RETURN
  354.  
  355. winner:
  356.   IF topflag>0 THEN restart
  357.   GOSUB flash
  358.   msgbox 1,"No more levels!!!"
  359.   msgbox 2,"Your initials will now be used in the Warm-Up Screen!"
  360.   FOR i=1 TO 120
  361.     x=16*INT(RND*27+2):y=8*INT(RND*14+2)
  362.     PUT (x,y),pparts(0,willi),PSET
  363.     SOUND x*10,.1,255,0:SOUND y*10,.1,255,1
  364.     x=16*INT(RND*27+2):y=8*INT(RND*14+2)
  365.     PUT (x,y),pparts(0,rock),PSET
  366.     SOUND x*10,.1,255,0:SOUND y*10,.1,255,1
  367.   NEXT
  368.   IF (totaltime!<topscore!(0) OR topscore!(0)=0) AND topflag<1 THEN
  369.     topscore!(0)=totaltime!:topname$(0)="****":topflag=-1
  370.   END IF
  371.   GOTO restart
  372.  
  373. hurrah:
  374.   IF topflag>0 THEN RETURN
  375.   msgbox 2,"Congradulations!!! - You have beaten a high score!"
  376.   FOR freq=300 TO 1000 STEP 20
  377.     SOUND freq,.5,255
  378.     SOUND freq*1.25,.5,255,1
  379.     SOUND freq*1.5,.5,255,2
  380.     SOUND freq*2,.5,255,3
  381.   NEXT
  382.   msgbox 1,"Enter your initials: ___":getname 389,3,top$
  383.   FOR i=0 TO 6
  384.     IF topname$(i)="****" THEN topname$(i)=top$
  385.   NEXT
  386.   GOSUB bestscores
  387.   OPEN file$+".scores" FOR OUTPUT AS #1
  388.     FOR i=0 TO 6:PRINT #1,topname$(i)","topscore!(i):NEXT
  389.   CLOSE #1:KILL file$+".scores.info"
  390.   topflag=0
  391.   RETURN
  392.  
  393. flash:
  394.   FOR i=0 TO 14:LINE (2*i,i)-(498-2*i,144-i),i,bf:NEXT
  395.   LINE (2*i,i)-(498-2*i,144-i),0,bf
  396.   RETURN
  397.  
  398. scoreboard:
  399.   LINE (503,3)-STEP(127,152),0,bf
  400.   LINE (505,4)-(566,26),8,bf:LINE (569,4)-(630,26),8,bf
  401.   LINE (507,5)-(564,25),1,bf:LINE (571,5)-(628,25),1,bf
  402.   LINE (509,6)-(562,24),8,bf:LINE (573,6)-(626,24),8,bf
  403.   LINE (511,7)-(560,23),1,bf:LINE (575,7)-(624,23),1,bf
  404.   COLOR 8,1
  405.   printat& 512,8,SADD("-YOUR-"+nl$)
  406.   printat& 512,16,SADD("-TIME-"+nl$)
  407.   printat& 576,8,SADD("-BEST-"+nl$)
  408.   printat& 576,16,SADD("-TIME-"+nl$)
  409.   FOR my=5 TO 15 STEP 2
  410.     c=(my-5)/2+2
  411.     dbox& 505,8*my-12,c+7,c,SADD("   0.0"+nl$)
  412.     dbox& 569,8*my-12,c+7,c,SADD("   0.0"+nl$)
  413.   NEXT
  414.   dbox& 505,124,8,1,SADD("TOTAL FOR GAME"+nl$)
  415.   dbox& 505,140,7,0,SADD("   0.0"+nl$)
  416.   dbox& 569,140,7,0,SADD("   0.0"+nl$)
  417.   RETURN
  418.  
  419. checkbox:
  420.   msgbox 2,""
  421.   dbox& 2,172,8,1,SADD("  Click here to continue operation   "+nl$)
  422.   dbox& 322,172,8,1,SADD("    Click here to return to game     "+nl$)
  423. checkloop:
  424.   CALL whoa:IF MOUSE(4)<171 THEN checkloop
  425.   IF MOUSE(3)>320 THEN inthebox=0 ELSE inthebox=-1
  426.   msgbox 1,"":msgbox 2,""
  427.   RETURN
  428.  
  429. menu1:
  430.   m=0
  431.   ON MENU(1) GOSUB about,instructions,show,quit
  432.   GOTO start
  433. about:
  434.   GOSUB flash
  435.   scolr& 2,9:shadow& 89,22,SADD("The Willi Construction Set (Version 2.0)"+nl$)
  436.   scolr& 1,8:shadow& 189,32,SADD("by john everett"+nl$)
  437.   scolr& 6,13:shadow& 181,42,SADD("PeopleLINK ID JAE"+nl$)
  438.   scolr& 7,14:shadow& 213,54,SADD("FEATURES:"+nl$)
  439.   scolr& 2,9:shadow& 45,64,SADD("Ability to create new screens or edit existing ones"+nl$)
  440.   scolr& 3,10:shadow& 113,74,SADD("Ability to edit the playing pieces"+nl$)
  441.   scolr& 4,11:shadow& 73,84,SADD("Vanity Board, with best score for each level"+nl$)
  442.   scolr& 5,12:shadow& 109,94,SADD("plus best score for total game time"+nl$)
  443.   scolr& 6,13:shadow& 113,104,SADD("Initials of best total time scorer"+nl$)
  444.   scolr& 7,14:shadow& 97,114,SADD("incorporated into Warm-Up Level screen"+nl$)
  445.   GOSUB checkbox:IF NOT inthebox THEN startflag=1:RETURN
  446. instructions:
  447.   GOSUB flash
  448.   scolr& 1,8:shadow& 197,24,SADD("INSTRUCTIONS:"+nl$)
  449.   scolr& 2,9:shadow& 101,39,SADD("Use joystick (port2) to control Willi"+nl$)
  450.   scolr& 3,10:shadow& 73,54,SADD("Collect flowers while avoiding falling rocks"+nl$)
  451.   scolr& 4,11:shadow& 93,69,SADD("If you get stuck,  press `r' for `rock'"+nl$)
  452.   scolr& 5,12:shadow& 65,84,SADD("(the rock will land on Willi's head,  however)"+nl$)
  453.   scolr& 6,13:shadow& 33,99,SADD("Pressing `R' on Warm-Up screens generates a new screen"+nl$)
  454.   scolr& 7,14:shadow& 97,114,SADD("Press ESC if you want to quit the game"+nl$)
  455.   GOSUB checkbox:IF NOT inthebox THEN startflag=1:RETURN
  456.   GOTO about
  457. show:
  458.   listflag=-1
  459.   GOTO quit
  460. slowquit:
  461.   whoa
  462. quit:
  463.   IF topflag THEN GOSUB hurrah
  464.   MENU RESET
  465.   CHDIR "/"
  466.   WINDOW CLOSE 2:SCREEN CLOSE 1
  467.   WINDOW 1
  468.   IF bye&>0 THEN CALL bye&
  469.   IF listflag=-1 THEN LIST:CLEAR,25000:END
  470.   CLEAR,25000
  471.   SOUND 1600,1,255,0:SOUND 2000,1,255,1
  472.   SOUND  100,2,255,0:SOUND  125,2,255,1
  473.   SYSTEM
  474.   END
  475.  
  476. menu2:
  477.   m=0:ON MENU(1) GOSUB loadscreens,editscreen,editpart,clearscores,restart
  478.   GOTO start
  479. loadscreens:
  480.   msg$=file$
  481.   file$="*.screens"+STRING$(340,0)
  482.   request& 20,15,SADD("Load new screen:"+nl$),SADD(file$),0
  483.   startflag=1
  484.   file$=LEFT$(file$,INSTR(file$,nl$)-1)
  485.   IF file$="" OR RIGHT$(file$,8)<>".screens" THEN file$="NOT A .screens FILE!":GOTO noload
  486.   file$=LEFT$(file$,LEN(file$)-8)
  487. newscreens:
  488.   checkfile& SADD(file$+".screens"+nl$),VARPTR(filesize&)
  489.   IF filesize&<>6696 THEN file$=file$+".screens":GOTO noload
  490.   checkfile& SADD(file$+".names"+nl$),VARPTR(filesize&)
  491.   IF filesize&<=0 THEN file$=file$+".names":GOTO noload
  492.   msgbox 1,"Loading "+file$+" screens..."
  493.   bload& SADD(file$+".screens"+nl$),VARPTR(backboard(0,0,1)),6696
  494.   OPEN file$+".names" FOR INPUT AS #1
  495.     FOR i=1 TO 6
  496.       INPUT #1,title$(i),wx(i),wy(i),greed(i)
  497.     NEXT
  498.   CLOSE #1
  499.   checkfile& SADD(file$+".scores"+nl$),VARPTR(filesize&)
  500.   IF filesize&>0 THEN
  501.     OPEN file$+".scores" FOR INPUT AS #1
  502.       FOR i=0 TO 6:INPUT #1,topname$(i),topscore!(i):NEXT
  503.     CLOSE #1
  504.   ELSE
  505.     FOR i=0 TO 6:topname$(i)="":topscore!(i)=0:NEXT
  506.   END IF
  507.   GOSUB setstart
  508. printscores:
  509.   FOR my=5 TO 15 STEP 2
  510.     c=(my-5)/2+2
  511.     COLOR c+7,c:printat& 512,8*my-8,SADD("   0.0"+nl$)
  512.     LOCATE my,73:PRINT USING "####.#";topscore!(c-1)
  513.   NEXT
  514.   COLOR 7,0:printat& 512,144,SADD("   0.0"+nl$)
  515.   LOCATE 19,73:PRINT USING "####.#";topscore!(0)
  516.   CLOSE #1
  517.   RETURN
  518. noload:
  519.   msgbox 1,file$+" not found... Load Aborted!"
  520.   BEEP:pause 3!
  521.   IF file$=default$ THEN quit
  522.   file$=msg$
  523.   RETURN
  524. editscreen:
  525.   msgbox 1,"THIS FUNCTION WILL DISQUALIFY ALL HIGH SCORES EARNED THIS GAME"
  526.   GOSUB checkbox:IF NOT inthebox THEN RETURN
  527.   IF topflag THEN GOSUB hurrah
  528.   MENU 1,0,0:MENU 2,0,0
  529.   GOSUB brick
  530.   LINE (503,0)-(631,155),,bf
  531.   LINE (0,156)-STEP(630,31),,bf
  532.   PATTERN ,empty
  533.   dbox& 506,4,8,1,SADD("Return To Game"+nl$)
  534.   FOR i=0 TO 5
  535.     dbox& 506,16*i+20,i+2,i+9,SADD("Get LEVEL"+MID$(STR$(i+1),2)+" Put"+nl$)
  536.   NEXT
  537.   dbox& 506,116,7,0,SADD(" Save Screens "+nl$)
  538.   LINE (505,132)-STEP(125,11),1,bf
  539.   LINE (507,133)-STEP(121,9),0,bf
  540.   FOR i=0 TO 5:PUT (20*i+509,134),pparts(0,i),PSET:NEXT
  541.   msgbox 1,"Click to change Level"+STR$(level)+" Title: "+LEFT$(title$(level)+SPACE$(32),32)
  542.   msgbox 2,"`Get' gets a level to display, `Put' swaps a level with display"
  543. showpart:
  544.   LINE (20*part+507,133)-STEP(19,9),8,bf
  545.   PUT (20*part+509,134),pparts(0,part),PSET
  546. scrnloop:
  547.   CALL whoa:mx=MOUSE(3):my=MOUSE(4)
  548.   IF my>156 AND my<171 AND mx>125 AND mx<508 THEN
  549.     getname 305,32,title$(level)
  550.     printat& 305,160,SADD(LEFT$(title$(level)+SPACE$(32),32)+nl$)
  551.   ELSEIF my<145 THEN
  552.     IF mx<497 THEN
  553.       WHILE MOUSE(0)<0
  554.         mx=INT(MOUSE(1)/16):my=INT(MOUSE(2)/8)
  555.         IF mx>30 OR my>17 THEN scrnloop
  556.         GOSUB boardpart
  557.       WEND
  558.     ELSE
  559.       my=INT((my-4)/16)
  560.       IF my<1 THEN donescreens
  561.       IF my<7 THEN
  562.         IF mx<545 THEN
  563.           GOSUB getscrn
  564.         ELSEIF mx>588 THEN
  565.           GOSUB putscrn
  566.         END IF
  567.       ELSEIF my=7 THEN
  568.         GOSUB savescreens
  569.       ELSE
  570.         LINE (20*part+507,133)-STEP(19,9),0,bf
  571.         PUT (20*part+509,134),pparts(0,part),PSET
  572.         part=INT((mx-507)/20)
  573.         GOTO showpart
  574.       END IF
  575.     END IF
  576.   END IF
  577.   GOTO scrnloop
  578. boardpart:
  579.   IF board(mx,my)=gold THEN greed=greed-1
  580.   IF part=3 THEN greed=greed+1
  581.   board(mx,my)=part
  582.   PUT (16*mx,8*my),pparts(0,part),PSET
  583.   RETURN
  584. getscrn:
  585.   level=my
  586.   GOSUB getboard
  587.   GOSUB showboard
  588.   COLOR 8,1:printat& 305,160,SADD(LEFT$(title$(level)+SPACE$(32),32)+nl$)
  589.   RETURN
  590. putscrn:
  591.   msgbox 1,"Click on Willi's starting position!"
  592.   i=my:whoa:mx=INT(MOUSE(3)/16):my=INT(MOUSE(4)/8)
  593.   IF mx>30 OR my>17 THEN CALL dbox&(2,148,8,1,SADD("Aborted."+nl$)):GOTO scrnloop
  594.   part=2:GOSUB boardpart                  -
  595.   copy& VARPTR(board(0,0)),VARPTR(backboard(0,0,0)),558
  596.   level=i:i=greed:GOSUB getboard:GOSUB showboard
  597.   copy& VARPTR(backboard(0,0,0)),VARPTR(backboard(0,0,level)),558
  598.   wx(level)=mx:wy(level)=my:greed(level)=i
  599.   msgbox 1,"Click to change Level"+STR$(level)+" Title: "+LEFT$(title$(level)+SPACE$(32),32)
  600.   RETURN
  601. savescreens:
  602.   msg$=file$
  603.   file$="*.screens"+STRING$(340,0)
  604.   request& 164,15,SADD("SAVE screens as:"+nl$),SADD(file$),1
  605.   file$=LEFT$(file$,INSTR(file$,nl$)-1)
  606.   IF file$="" THEN file$=msg$:GOSUB showboard:RETURN
  607.   IF RIGHT$(file$,8)=".screens" THEN file$=LEFT$(file$,LEN(file$)-8)
  608.   file$=UCASE$(file$)
  609.   IF file$="STONE-AGE" OR file$="WCS" THEN
  610.     msgbox 1,"Aborted.  You must use a different filename."
  611.     RETURN
  612.   END IF
  613.   bsave& SADD(file$+".screens"+nl$),VARPTR(backboard(0,0,1)),6696
  614.   OPEN file$+".names" FOR OUTPUT AS #1
  615.     FOR i=1 TO 6
  616.       PRINT #1,title$(i)",";
  617.       PRINT #1,wx(i)",";
  618.       PRINT #1,wy(i)",";
  619.       PRINT #1,greed(i)
  620.     NEXT
  621.   CLOSE #1:KILL file$+".names.info"
  622.   checkfile& SADD(file$+".scores"+nl$),VARPTR(filesize&)
  623.   IF filesize&>0 THEN KILL file$+".scores"
  624.   GOSUB showboard
  625.   RETURN
  626. donescreens:
  627.   MENU 1,0,1:MENU 2,0,1
  628.   GOSUB brick
  629.   LINE (503,0)-(631,155),,bf
  630.   LINE (0,145)-(502,155),,bf
  631.   LINE (0,156)-STEP(630,31),,bf
  632.   PATTERN ,empty
  633.   GOSUB scoreboard
  634.   msgbox 1,file$+" - Level"+STR$(level)+": "+title$(level)
  635.   startflag=2:topflag=1:newrandom=-1
  636.   RETURN
  637. editpart:
  638.   MENU 1,0,0:MENU 2,0,0
  639.   GOSUB brick
  640.   LINE (0,0)-(498,144),,bf
  641.   LINE (0,156)-STEP(630,31),,bf
  642.   PATTERN ,empty
  643.   LINE (50,8)-STEP(298,146),0,bf
  644.   LINE (54,9)-STEP(290,144),15,bf
  645.   dbox& 364,35,4,11,SADD("  STORE PART  "+nl$)
  646.   dbox& 364,76,5,12,SADD("  SAVE PARTS  "+nl$)
  647.   dbox& 364,117,6,13,SADD("RETURN TO GAME"+nl$)
  648.   FOR c=0 TO 15:dbox& c*38+14,164,c,0,SADD("  "+nl$):NEXT:c=1
  649.   LINE (62,169)-STEP(10,4),1,bf
  650.   LINE (12,55)-STEP(27,52),0,bf
  651.   FOR i=0 TO 4
  652.     LINE (16,10*i+56)-STEP(19,9),-8*(i=part),bf
  653.     PUT (18,10*i+57),pparts(0,i),PSET
  654.   NEXT
  655. whichpart:
  656.   FOR my=0 TO 7:FOR mx=0 TO 15
  657.     LINE (18*mx+56,18*my+10)-STEP(16,16),POINT (mx+18,my+10*part+57),bf
  658.   NEXT:NEXT
  659. partloop:
  660.   whoa
  661.   IF m=3 THEN m=0:MENU 3,part+1,1:part=MENU(1)-1:GOTO whichpart
  662.   mx=MOUSE(3):my=MOUSE(4)
  663.   IF mx<10 AND my<5 THEN quit
  664.   IF my>163 AND my<178 THEN
  665.     LINE (c*38+24,169)-STEP(10,4),0,bf
  666.     c=INT((mx-6)/38) AND 15
  667.     LINE (c*38+24,169)-STEP(10,4),1,bf
  668.   ELSEIF mx>14 AND mx<37 THEN
  669.     LINE (16,10*part+56)-STEP(19,9),0,bf
  670.     PUT (18,10*part+57),pparts(0,part),PSET
  671.     part=INT((my-56)/10)
  672.     LINE (16,10*part+56)-STEP(19,9),8,bf
  673.     PUT (18,10*part+57),pparts(0,part),PSET
  674.     GOTO whichpart
  675.   ELSEIF mx>363 AND mx<490 THEN
  676.     IF my>35 AND my<50 THEN
  677.       GOSUB usepart
  678.     ELSEIF my>76 AND my<91 THEN
  679.       GOSUB usepart
  680.       i=96:filesize&=1
  681.       WHILE filesize&>0 AND i<124
  682.         i=i+1:checkfile& SADD("pieces.parts."+CHR$(i)+nl$),VARPTR(filesize&)
  683.       WEND
  684.       IF i<124 THEN
  685.         NAME "pieces.parts" AS "pieces.parts."+CHR$(i)
  686.         bsave& SADD("pieces.parts"+nl$),VARPTR(pparts(0,0)),376
  687.         SOUND 1200,.5,255,1:SOUND 1000,1,255,0
  688.       END IF
  689.     ELSEIF my>117 AND my<132 THEN
  690.       MENU 1,0,1:MENU 2,0,1
  691.       GOSUB brick
  692.       LINE (0,0)-(498,156),,bf
  693.       LINE (0,156)-STEP(630,31),,bf
  694.       PATTERN ,empty
  695.       RETURN
  696.     END IF
  697.   ELSEIF mx>55 AND mx<344 AND my>9 AND my<154 THEN
  698.     mx=INT((MOUSE(1)-56)/18):my=INT((MOUSE(2)-10)/18)
  699.     WHILE MOUSE(0)<0
  700.       mx=INT((MOUSE(1)-56)/18)
  701.       IF mx<0 THEN mx=0
  702.       IF mx>15 THEN mx=15
  703.       my=INT((MOUSE(2)-10)/18)
  704.       IF mxy<0 THEN my=0
  705.       IF my>7 THEN my=7
  706.       PSET (mx+18,my+10*part+57),c:LINE (18*mx+56,18*my+10)-STEP(16,16),c,bf
  707.     WEND
  708.   END IF
  709.   GOTO partloop
  710. usepart:
  711.   GET (18,10*part+57)-(33,10*part+64),pparts(0,part)
  712.   SOUND 1200,.5,255,1:SOUND 1000,1,255,0
  713.   RETURN
  714. clearscores:
  715.   startflag=2
  716.   msgbox 1,"WHAT YOU ARE ABOUT TO DO WILL SET ALL SCORES TO ZERO!"
  717.   GOSUB checkbox:IF NOT inthebox THEN start
  718. nochance:
  719.   FOR i=6 TO 0 STEP -1
  720.     topscore!(i)=0:topname$(i)=""
  721.     SOUND 20*i+140,.5,255:SOUND 20*i+140,2,255,1
  722.   NEXT
  723.   GOSUB printscores
  724. restart:
  725.   GOSUB setstart
  726.   GOTO start
  727.  
  728. SUB whoa STATIC
  729.   WHILE MOUSE(0)<>0:WEND:WHILE MOUSE(0)=0:SLEEP:WEND
  730. END SUB
  731.  
  732. SUB pause(delay!) STATIC
  733.   WHILE MOUSE(0)<>0:WEND
  734.   delay!=TIMER+delay!
  735.   WHILE TIMER<delay! AND MOUSE(0)=0:WEND
  736. END SUB
  737.  
  738. SUB msgbox(y,msg$) STATIC
  739.   SHARED brick(),empty(),dbox&,nl$
  740.   PATTERN ,brick
  741.   POKE WINDOW(8)+29,-3 AND 255:COLOR 15,0
  742.   LINE (0,156-16*(y=2))-STEP(630,14),,bf
  743.   PATTERN ,empty
  744.   IF msg$<>"" THEN CALL dbox&(-1,156-16*(y=2),8,1,SADD(msg$+nl$))
  745. END SUB
  746.  
  747. SUB getname(x,length,msg$) STATIC
  748.   SHARED printat&,nl$
  749.   position=1
  750. getmore:
  751.   IF position>length THEN position=length
  752.   IF position<1 THEN position=1
  753.   msg$=LEFT$(msg$+SPACE$(length),length)
  754.   COLOR 1,8:printat& x,160,SADD(msg$+nl$)
  755.   COLOR 8,1:printat& 8*(position-1)+x,160,SADD(MID$(msg$,position,1)+nl$)
  756.   in$="":WHILE in$="":in$=INKEY$:SLEEP:WEND
  757.   value=ASC(in$)
  758.   IF value=30 THEN
  759.     position=position+1
  760.   ELSEIF value=31 THEN
  761.     position=position-1
  762.   ELSEIF value=8 THEN
  763.     IF position>1 THEN msg$=LEFT$(msg$,position-2)+MID$(msg$,position)
  764.     position=position-1
  765.   ELSEIF value=127 AND position<length THEN
  766.     msg$=LEFT$(msg$,position-1)+MID$(msg$,position+1)
  767.   ELSEIF value=27 THEN
  768.     msg$=SPACE$(length):position=1
  769.   ELSEIF value>31 AND value<127 THEN
  770.     IF position=1 THEN
  771.       msg$=in$+MID$(msg$,position)
  772.     ELSE
  773.       msg$=LEFT$(msg$,position-1)+in$+MID$(msg$,position)
  774.     END IF
  775.     position=position+1
  776.   END IF
  777.   IF value<>13 THEN getmore
  778.   COLOR 8,1:printat& x,160,SADD(msg$+nl$)
  779.   WHILE RIGHT$(msg$,1)=" ":msg$=LEFT$(msg$,LEN(msg$)-1):WEND
  780. END SUB
  781.